COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE MKFONT - MAKE FONT - BGB - 2 FEBRUARY 1973.
C00003 00003	SUBR(MKFONT)------------------------------------------------------
C00005 00004	SUBR(MKGLY2)IMAGE-------------------------------------------------
C00010 00005	SUBR(DAG1)--------------------------------------------------------
C00013 00006	SUBR(FNTPAK,CHAR)--------------------------------------------------
C00015 ENDMK
C⊗;
TITLE MKFONT - MAKE FONT - BGB - 2 FEBRUARY 1973.

INTERNAL MKFONT,ORGPTR,ENDPTR
EXTERNAL SEGFNT,PAK,PAKEND

;VARIABLES GLOBAL TO THE SUBROUTINES OF THIS FILE.

	EXTERN RMIN,RMAX,CMIN,CMAX,FILM
	DECLARE{CMAX2}
	DECLARE{ROWCNT,COLCNT,WRDWID,GSIZE}
	DECLARE{GPTR,ORGPTR,ENDPTR}		;FONT SEGMENT.
;	DECLARE{ORGROW,ORGCOL,ENDROW,ENDCOL}	;GLYPH POSITIONING.
	DECLARE{BITS,BYTCNT}

	$←400000
	O(CORE2,CALLI 400015)
SUBR(MKFONT)------------------------------------------------------
BEGIN MKFONT; MAKE FONT - BGB - 2 FEBRUARY 1973.
	EXTERN CTRL,META,SHRINK
	MOVE CTRL↔AND META↔JUMPN L0		;CONTINUE FONT.
	SETZM HFLAG↔SKIPE CTRL↔SETOM HFLAG

;CREATE FONT SEGMENT.
	CALL(SEGFNT)				;GET AN UPPER SEGMENT
;	SETZ↔CORE2↔HALT
	MOVEI $+1777↔MOVEM ENDPTR
;	CORE2↔HALT				;MAKE UPPER SEG.
	SETZM $↔MOVE[XWD $,$+1]↔BLT $+1777	;CLEAR FONT SPACE.
;	MOVE[SIXBIT/FONT/]↔CALLI $+36↔JFCL	;NAME UPPER SEG.
	MOVEI $+400↔MOVEM ORGPTR
	OUTSTR[ASCIZ/FONT DESCRIPTION (ONE LINE):/]
	TTYUUO 14,				;WAIT FOR LINE TO BE TYPED
	MOVEI $+240
	DDTIN
L0:	SETZM CTRL↔SETZM META
	MOVE 1,FILM↔SON 1,1↔SKIPN 1↔POP0J	;IMAGE.
	MOVEM 1,IMAGE0↔MOVEM 1,IMAGE1↔GO L2

;CREATE A GLYPH FOREACH IMAGE OF THE FILM.
L1:	EXTERN NEXIMG↔CALL(NEXIMG)
	MOVE 1,FILM↔SON 1,1↔MOVEM 1,IMAGE1
	CAMN 1,IMAGE0↔GO L3
L2:	EXTERN REGION↔CALL(REGION)
	CALL(MKGLY2,IMAGE1)
	CALL(DAG1)↔GO L1	;ONE INTO ONE.

L3:	SETZM RMIN↔SETZM RMAX
	EXTERN DPYPAK↔CALL(DPYPAK)
	OUTSTR[ASCIZ/	END OF MAKE FONT.
/]↔	CALL(SHRINK)
	POP0J

	DECLARE{IMAGE0,IMAGE1}

↑HFLAG:	0
BEND;2/2/73-------------------------------------------------------
SUBR(MKGLY2)IMAGE-------------------------------------------------
BEGIN MKGLY2;ALLOCATE GLYPH SPACE AND DIMENSIONS.

	ACCUMULATORS{A,B,LVL}
	MOVE 1,ARG1
	SON LVL,1
	PGON 0,LVL↔ADDI 0,40↔ANDCMI 0,77
	ASH 0,-6↔MOVEM 0,WIDTH#			;OPTIONAL WIDTH
	NCNT A,LVL				;ASCII CODE.
	CAIGE A,200↔SKIPG A
	GO[OUTSTR[ASCIZ/	CHARACTER = /]
		INCHRW A↔NCNT. A,LVL↔CRLF↔GO .+1]

;PLACE GLYPH POINTER INTO ASCII TABLE.

	MOVEM A,CHAR
	MOVE B,ORGPTR
	TRZ B,$
	SKIPE $(A)
	GO [ OUTSTR[ASCIZ/DUPLICATE CHARACTER: '/]
	     OUTCHR A	
	     OUTSTR[ASCIZ/'.  GLYPH SKIPPED.
/]
	     AOS(P)
	     POP1J]
	OUTCHR A
	MOVEM B,$(A)

;COMPUTE GLYPH DIMENSIONS.
	
	MOVEI =144↔CAMG CMIN
	GO [ MOVEM CMIN
	     GO C0]
	OUTSTR[ASCIZ/ WAS MOVED RIGHT.	/]
	MOVE CMIN↔SETZM WIDFLG#
C0:	ADD WIDTH
	CAML CMAX↔GO [ MOVEM CMAX
		       SETOM WIDFLG
		       SKIPN CMAX
		       SKIPE RMAX
		       GO .+1
		       MOVEI 2
		       MOVEM GSIZE 
		       SETZM ROWCNT
		       POP1J ]
	MOVE RMAX↔SUB RMIN↔AOS		;CALCULATE ROW COUNT
	SKIPGE 0↔SETZ 0,
	SKIPN HFLAG↔GO M1
	TRNE 1↔AOS↔ASH -1
M1:	MOVEM ROWCNT
	MOVE CMAX↔SUB CMIN↔AOS		;CALCULATE REAL COLUMN COUNT
	SKIPGE 0↔SETZ 0,
	SKIPN HFLAG↔GO M2
	TRNE 1↔AOS↔ASH -1
M2:	MOVEM COLCNT

;	IDIVI =36↔SKIPE 1↔AOS↔MOVEM WRDWID
;	MOVE WRDWID↔IMUL ROWCNT↔ADDI 3↔MOVEM GSIZE
  
;	MOVE WRDWID↔IMULI =72↔ADD CMIN↔SOS↔MOVEM CMAX2
;	MOVE WRDWID↔IMULI =36↔SKIPE HFLAG↔IMULI 2↔ADD CMIN↔SOS↔MOVEM CMAX2
	MOVE COLCNT
	SKIPE WIDFLG↔GO[HRLZ 0,0↔GO .+3]	;IF WIDTH IS DEFINED, USE IT
	ADDI 1↔	IMUL [1040000]			;OTHERWISE, ADD SOME SPACING
	MOVE A,CHAR↔HLLM 0,$(A)			;UPDATE TABLE ENTRY
	HLRZ 0,0↔MOVEM COLCNT
	SKIPE HFLAG↔IMULI 2↔ADD CMIN↔SOS↔MOVEM CMAX2	;FIND LAST COLUMN
	MOVE COLCNT↔IDIVI =36↔SKIPE 1↔AOS↔MOVEM WRDWID	;AND WORD WIDTH
	MOVEI =36↔IDIV COLCNT			;NUMBER OF BYTES PER WORD
	SKIPN 0↔MOVEI 1↔MOVEM BYTCNT	;IF MORE THAN 1 WORDS/BYTE, SET TO 1
	MOVE ROWCNT↔IMUL WRDWID↔SOS↔IDIV BYTCNT↔AOS	;GLYPH WORD COUNT
	ADDI 2↔MOVEM GSIZE			;PLUS 2 FOR DESCRIPTOR
	MOVE BYTCNT↔IMUL COLCNT↔MOVEM BITS	;NUMBER OF BITS USED IN WORD

;COMPUTE GLYPH POSITION.

;	MOVE ROWCNT↔MOVEM ENDROW
;	MOVE ROWCNT↔MOVNM ORGROW
;	SETZM ORGCOL
;	MOVE COLCNT↔ADDI 5↔MOVEM ENDCOL

;UPDATE ORG POINTER AND EXPAND FONT SPACE WHEN NECESSARY.

	MOVE ORGPTR↔MOVEM GPTR
	ADD GSIZE↔MOVEM ORGPTR
	CAMG ENDPTR↔POP1J
	MOVE ENDPTR↔ADDI 2000↔MOVEM ENDPTR
	CORE2↔GO[FATAL({FONT SPACE EXHAUTED.})]
	MOVE ENDPTR↔SUBI 1777↔SETZM@↔HRLM↔AOS
	MOVE 1,ENDPTR↔BLT(1)↔POP1J

BEND;2/2/73-------------------------------------------------------
CHAR:	0
SUBR(DAG1)--------------------------------------------------------
BEGIN DAG1;DEPOSIT GLYPH INTO FONT - 1 FOR 1 - BGB - 2 FEB 1973.
	EXTERN PAKPTR
	ACCUMULATORS{R,C,G,PTR,GLY,CNT,BCNT}
	MOVE G,GPTR		;GLYPH POINTER.
;HEADER.
;	MOVE ROWCNT↔HRLM 0(G)	;ROW COUNT.
;	MOVE WRDWID↔HRRM 0(G)	;WORD WIDTH.
;	MOVE ORGROW↔HRLM 1(G)	;ORIGIN VECTOR.
;	MOVE ORGCOL↔HRRM 1(G)
;	MOVE ENDROW↔HRLM 2(G)	;END VECTOR.
;	MOVE ENDCOL↔HRRM 2(G)
	MOVE GSIZE↔HRL CHAR↔MOVEM 0(G)
	MOVE RMIN↔SKIPN RMAX↔MOVEI =108
	SKIPN HFLAG↔GO H1
	SOS↔ASH -1↔ADDI 1+=54
H1:	SUBI 1↔HRL ROWCNT↔MOVSM 1(G)
	MOVE 0,GSIZE↔CAIN 0,2↔POP0J	;QUICK EXIT FOR BLANK CHARACTERS

;MOVE BIT ARRAY INTO GLYPH.

	MOVE GLY,[POINT 1,0,-1]
	ADDI GLY,2(G)
	MOVE R,RMIN
	SKIPE HFLAG
	GO M0+1
	GO L0+1
L0:	TLZ GLY,770000		;FORCE WORD BOUNDARY
	MOVE BCNT,BITS		;SET BITS USED IN WORD
L1:	MOVE C,CMIN↔LSH R,3	;1 FOR 1
L2:	LDB PAKPTR(C)		;DOUBLE INDEXED BY (R).
	IDPB GLY
	AOS C
	CAMG C,CMAX2↔GO L2
	LSH R,-3↔AOS R
;	CAMG R,RMAX↔GO L1
;	POP0J
	CAMLE R,RMAX
	POP0J
	SUB BCNT,COLCNT		;SUBTRACT BITS USED IN THIS WORD(S)
	JUMPG BCNT,L1		;CONTINUE THIS WORD IF MORE BITS LEFT
	GO L0			;START NEW WORD

M0:	TLZ GLY,770000		;FORCE WORD BOUNDARY
	MOVE BCNT,BITS		;SET BITS USED IN WORD
M1:	MOVE C,CMIN↔LSH R,3	;4 INTO 1
M2:	SETZ CNT,
	LDB PAKPTR(C)↔SKIPE↔AOS CNT↔AOS C
	LDB PAKPTR(C)↔SKIPE↔AOS CNT↔SOS C↔ADDI R,8
	LDB PAKPTR(C)↔SKIPE↔AOS CNT↔AOS C
	LDB PAKPTR(C)↔SKIPE↔AOS CNT↔AOS C↔SUBI R,8
	SETZ↔CAILE CNT,1↔SETO↔IDPB GLY
	CAMG C,CMAX2↔GO M2
	LSH R,-3↔AOS R↔AOS R
;	CAMG R,RMAX↔GO M1
;	POP0J
	CAMLE R,RMAX
	POP0J
	SUB BCNT,COLCNT		;SUBTRACT BITS USED IN THIS WORD
	JUMPG BCNT,M1		;CONTINUE THIS WORD IF MORE BITS LEFT
	GO M0			;START NEW WORD
BEND;2/2/73-------------------------------------------------------
SUBR(FNTPAK,CHAR)--------------------------------------------------
BEGIN FNTPAK
	ACCUMULATORS{T1,ADR,ROWS}
	CALL(SEGFNT)
	MOVE 1,ARG1
	SKIPG ADR,$(1)
	POP1J
	HLRZ 0,$(ADR)
	CAME 0,1
	GO [ FATAL(INVALID FONT FILE) ]
	MOVE ROWS,[XWD ACCODE,ROWS+1]
	BLT ROWS,LASTAC
	MOVE ROWS,[XWD PAK,PAK+1]
	SETZM PAK
	BLT ROWS,PAKEND
	HLRE 0,ADR
	MOVE T1,0
	IDIVI 0,44
	HRRZ ADR,ADR
	ADD ADR,[XWD 004400,$+1]
	SKIPN 0
	DPB 1,[POINT 6,ADR,11]
	SKIPE 1
	ADDI 0,1
	HRRM 0,WWLOC
	MOVN 0,0
	ADDI 0,=288/=36
	HRRM 0,INCLOC
	HLRE 1,(ADR)
	SUB 1,$+203
	ADDI 1,=216/=2
	MOVEM 1,RMIN
	IMULI 1,=288/=36
	ADDI 1,PAK+=288/=72-1
	HLL 1,ADR
	ADDI T1,=288/=2-1
	MOVEM T1,CMAX
	MOVEI T1,=288/=2
	MOVEM T1,CMIN
	MOVE T1,RMIN
	ADD T1,(ADR)
	HRRZM T1,RMAX
	HRRZ ROWS,(ADR)
	AOS (P)
	GO ACGO
ACCODE:	PHASE ROWS+1
WWLOC:	MOVEI 0,0		;WORD WIDTH GOES HERE
	ILDB T1,ADR
	IDPB T1,1
	SOJG 0,.-2
INCLOC:	ADDI 1,0		;PAK ROW INCREMENT GOES HERE
	TLZ 1,770000
ACGO:	SOJGE ROWS,WWLOC
	DETSEG
LASTAC:	POP1J
	DEPHASE
BEND FNTPAK

END